home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / sorthelp.cls < prev    next >
Text File  |  1997-06-14  |  4KB  |  154 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CSortHelper"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. Implements ISortHelper
  13.  
  14. Public Enum EErrorSortHelper
  15.     eeBaseSortHelper = 13220    ' CSortHelper
  16.     eeMissingKey                ' Key is missing
  17. End Enum
  18.  
  19. Enum ESortMode
  20.     esmUnsorted = -1
  21.     esmSortVal
  22.     esmSortText
  23.     esmSortBin
  24.     esmSortLen
  25. End Enum
  26.  
  27. Private esmMode As Integer
  28. Private fHiToLo As Boolean
  29.  
  30. ' Modify to add more sort modes
  31. Private Function ISortHelper_Compare(v1 As Variant, _
  32.                                      v2 As Variant) As Integer
  33.     ' Use string comparisons only on strings
  34.     If TypeName(v1) <> "String" Then esmMode = esmSortVal
  35.     
  36.     Dim i As Integer
  37.     Select Case esmMode
  38.     ' Sort by value (same as esmSortBin for strings)
  39.     Case esmSortVal
  40.         If v1 < v2 Then
  41.             i = -1
  42.         ElseIf v1 = v2 Then
  43.             i = 0
  44.         Else
  45.             i = 1
  46.         End If
  47.     ' Sort case-insensitive
  48.     Case esmSortText
  49.         i = StrComp(v1, v2, 1)
  50.     ' Sort case-sensitive
  51.     Case esmSortBin
  52.         i = StrComp(v1, v2, 0)
  53.     ' Sort by string length
  54.     Case esmSortLen
  55.         If Len(v1) = Len(v2) Then
  56.             If v1 = v2 Then
  57.                 i = 0
  58.             ElseIf v1 < v2 Then
  59.                 i = -1
  60.             Else
  61.                 i = 1
  62.             End If
  63.         ElseIf Len(v1) < Len(v2) Then
  64.             i = -1
  65.         Else
  66.             i = 1
  67.         End If
  68.     End Select
  69.     If fHiToLo Then i = -i
  70.     ISortHelper_Compare = i
  71. End Function
  72.  
  73. Private Sub ISortHelper_Swap(v1 As Variant, v2 As Variant)
  74.     Dim vT As Variant
  75.     vT = v1
  76.     v1 = v2
  77.     v2 = vT
  78. End Sub
  79.  
  80. Private Sub ISortHelper_CollectionSwap(n As Collection, _
  81.                                        i1 As Variant, _
  82.                                        i2 As Variant, _
  83.                                        Optional key1 As Variant, _
  84.                                        Optional key2 As Variant)
  85.                                        
  86.     ' Be sure both keys are used or neither key is used
  87.     If IsMissing(key1) Xor IsMissing(key2) Then
  88.         ErrRaise eeMissingKey
  89.     End If
  90.     
  91.     Dim v1 As Variant, v2 As Variant, vT As Variant
  92.     If IsMissing(key1) Then     ' Swap without keys
  93.         v1 = n(i1)
  94.         n.Add n(i2), , , i1
  95.         n.Remove i1
  96.         n.Add v1, , , i2
  97.         n.Remove i2
  98.     Else                        ' Swap with keys
  99.         v1 = n(i1)
  100.         v2 = n(i2)
  101.         n.Add vT, , , i1        ' Add placeholder after i1
  102.         n.Remove i1
  103.         n.Add vT, , , i2        ' Add placeholder after i2
  104.         n.Remove i2
  105.         n.Add v2, key2, , i1
  106.         n.Remove i1             ' Remove first placeholder
  107.         n.Add v1, key1, , i2
  108.         n.Remove i2             ' Remove second placeholder
  109.    End If
  110.     
  111. End Sub
  112.  
  113. Property Get SortMode() As Integer
  114.     SortMode = esmMode
  115. End Property
  116.  
  117. Property Let SortMode(esmModeA As Integer)
  118.     Select Case esmModeA
  119.     Case esmSortVal, esmSortText, esmSortBin, esmSortLen
  120.         esmMode = esmModeA
  121.     Case Else
  122.         esmMode = esmSortVal
  123.     End Select
  124. End Property
  125.  
  126. Property Get HiToLo() As Boolean
  127.     HiToLo = fHiToLo
  128. End Property
  129.  
  130. Property Let HiToLo(fHiToLoA As Boolean)
  131.     fHiToLo = fHiToLoA
  132. End Property
  133.  
  134. #If fComponent = 0 Then
  135. Private Sub ErrRaise(e As Long)
  136.     Dim sText As String, sSource As String
  137.     If e > 1000 Then
  138.         sSource = App.ExeName & ".SortHelper"
  139.         Select Case e
  140.         Case eeBaseSortHelper
  141.             BugAssert True
  142.         Case eeMissingKey
  143.             sText = "CollectionSwap: Key is missing"
  144.         End Select
  145.         Err.Raise COMError(e), sSource, sText
  146.     Else
  147.         ' Raise standard Visual Basic error
  148.         sSource = App.ExeName & ".VBError"
  149.         Err.Raise e, sSource
  150.     End If
  151. End Sub
  152. #End If
  153.  
  154.